home *** CD-ROM | disk | FTP | other *** search
/ Cookbook USA: Drips, Dressings & Sauces / Cookbook USA - Drips, Dressings & Sauces (1997)(MicroMedia).iso / ch15 / frmsearc.frm < prev    next >
Text File  |  1996-07-05  |  16KB  |  513 lines

  1. VERSION 2.00
  2. Begin Form frmSearch 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00FFFF80&
  5.    Caption         =   "Cookbook U.S.A. (Search)"
  6.    ClientHeight    =   4920
  7.    ClientLeft      =   1005
  8.    ClientTop       =   2505
  9.    ClientWidth     =   7365
  10.    Height          =   5325
  11.    Icon            =   FRMSEARC.FRX:0000
  12.    Left            =   945
  13.    LinkTopic       =   "Form2"
  14.    ScaleHeight     =   4920
  15.    ScaleWidth      =   7365
  16.    Top             =   2160
  17.    Width           =   7485
  18.    Begin CommandButton cmdExitCB 
  19.       Caption         =   "E&xit Cookbook"
  20.       Height          =   475
  21.       Left            =   5040
  22.       TabIndex        =   16
  23.       Top             =   4290
  24.       Width           =   2175
  25.    End
  26.    Begin CommandButton cmdExit 
  27.       BackColor       =   &H00FF0000&
  28.       Caption         =   "&Prev. Screen"
  29.       Height          =   495
  30.       Left            =   5040
  31.       TabIndex        =   15
  32.       Top             =   3705
  33.       Width           =   2175
  34.    End
  35.    Begin CommandButton cmdSearch 
  36.       BackColor       =   &H00FF0000&
  37.       Caption         =   "&Search"
  38.       Height          =   495
  39.       Left            =   5040
  40.       TabIndex        =   13
  41.       Top             =   120
  42.       Width           =   2175
  43.    End
  44.    Begin CommandButton cmdClear 
  45.       BackColor       =   &H00FF0000&
  46.       Caption         =   "&Clear Search Fields"
  47.       Height          =   495
  48.       Left            =   5040
  49.       TabIndex        =   14
  50.       Top             =   840
  51.       Width           =   2175
  52.    End
  53.    Begin TextBox txtPreparationWords 
  54.       Height          =   300
  55.       Left            =   120
  56.       TabIndex        =   11
  57.       Top             =   4560
  58.       Width           =   4695
  59.    End
  60.    Begin TextBox txtIngredients8 
  61.       Height          =   300
  62.       Left            =   120
  63.       TabIndex        =   10
  64.       Top             =   3720
  65.       Width           =   4695
  66.    End
  67.    Begin TextBox txtIngredients7 
  68.       Height          =   300
  69.       Left            =   120
  70.       TabIndex        =   9
  71.       Top             =   3360
  72.       Width           =   4695
  73.    End
  74.    Begin TextBox txtIngredients6 
  75.       Height          =   300
  76.       Left            =   120
  77.       TabIndex        =   8
  78.       Top             =   3000
  79.       Width           =   4695
  80.    End
  81.    Begin TextBox txtIngredients5 
  82.       Height          =   300
  83.       Left            =   120
  84.       TabIndex        =   7
  85.       Top             =   2640
  86.       Width           =   4695
  87.    End
  88.    Begin TextBox txtIngredients4 
  89.       Height          =   300
  90.       Left            =   120
  91.       TabIndex        =   6
  92.       Top             =   2280
  93.       Width           =   4695
  94.    End
  95.    Begin TextBox txtIngredients3 
  96.       Height          =   300
  97.       Left            =   120
  98.       TabIndex        =   5
  99.       Top             =   1920
  100.       Width           =   4695
  101.    End
  102.    Begin TextBox txtIngredients2 
  103.       Height          =   300
  104.       Left            =   120
  105.       TabIndex        =   4
  106.       Top             =   1560
  107.       Width           =   4695
  108.    End
  109.    Begin TextBox txtIngredients1 
  110.       Height          =   300
  111.       Left            =   120
  112.       TabIndex        =   3
  113.       Top             =   1200
  114.       Width           =   4695
  115.    End
  116.    Begin TextBox txtTitleWords 
  117.       Height          =   300
  118.       Left            =   120
  119.       TabIndex        =   1
  120.       Top             =   360
  121.       Width           =   4695
  122.    End
  123.    Begin Label lblPreparationWords 
  124.       BackColor       =   &H00FF80FF&
  125.       BorderStyle     =   1  'Fixed Single
  126.       Caption         =   "Words Describing the &Preparation:"
  127.       Height          =   255
  128.       Left            =   120
  129.       TabIndex        =   12
  130.       Top             =   4320
  131.       Width           =   4695
  132.    End
  133.    Begin Label lblIngredientWords 
  134.       BackColor       =   &H00FF80FF&
  135.       BorderStyle     =   1  'Fixed Single
  136.       Caption         =   "&Ingredients:"
  137.       Height          =   255
  138.       Left            =   120
  139.       TabIndex        =   2
  140.       Top             =   960
  141.       Width           =   4695
  142.    End
  143.    Begin Label lblTitleWords 
  144.       BackColor       =   &H00FF80FF&
  145.       BorderStyle     =   1  'Fixed Single
  146.       Caption         =   "Words within &Title:"
  147.       Height          =   255
  148.       Left            =   120
  149.       TabIndex        =   0
  150.       Top             =   120
  151.       Width           =   4695
  152.    End
  153. End
  154. ' frmSearch gets search criteria from the user and performs
  155. ' a search.  Control is then returned to frmMain, but
  156. ' the current TRList will contain only those items that
  157. ' match the criteria requested.
  158.  
  159. Option Explicit
  160.  
  161. '--------------------------------------------------------------------------
  162. Sub cmdClear_Click ()
  163.     
  164.     txtTitleWords = ""
  165.     txtIngredients1 = ""
  166.     txtIngredients2 = ""
  167.     txtIngredients3 = ""
  168.     txtIngredients4 = ""
  169.     txtIngredients5 = ""
  170.     txtIngredients6 = ""
  171.     txtIngredients7 = ""
  172.     txtIngredients8 = ""
  173.     txtPreparationWords = ""
  174.  
  175.     txtTitleWords.SetFocus
  176.  
  177. End Sub
  178.  
  179. '--------------------------------------------------------------------------
  180. Sub cmdExit_Click ()
  181.         
  182.     MakeMouseCursorHourglass
  183.     Load frmCookbook
  184.     frmCookbook.Show
  185.     Hide
  186.     MakeMouseCursorDefault
  187.  
  188. End Sub
  189.  
  190. Sub cmdExitCB_Click ()
  191.     Dim r
  192.     If InfoLinkOpen Then
  193.         If TRListID <> 0 Then
  194.             r = CloseTRList(TRListID)
  195.         End If
  196.         
  197.         Call TextCompMemoryFree
  198.         If r <> 0 Then MsgBox "INFOLINK.DLL was not able to release memory used for decompression.  Some Windows resources may be lost.  You may want to restart Windows.", 48, "Error in unloading"
  199.         r = CloseIndex(IndexId)
  200.         If r <> 0 Then MsgBox "INFOLINK.DLL was not able to Close the Cookbook index.  You may want to restart Windows.", 48, "Error in unloading"
  201.         r = CloseInfoLink()
  202.         If r <> 0 Then MsgBox "INFOLINK.DLL was not able to shut down properly.  You may want to restart windows to release trapped resources.", 48, "Error in unloading"
  203.     End If
  204.  
  205.     '     "Goodnight, Everybody!"  - Yakko Warner
  206.     End
  207.  
  208.  
  209. End Sub
  210.  
  211. '--------------------------------------------------------------------------
  212. Sub cmdSearch_Click ()
  213.     
  214.     ReDim SearchWord$(100)
  215.     Dim Title As String
  216.     Dim Ingred As String
  217.     Dim Prep As String
  218.     Dim SearchBuffer As String
  219.     Dim SearchExp As String
  220.     Dim x As Integer
  221.     Dim IngredFieldLoc As Integer
  222.     Dim PrepfieldLoc As Integer
  223.     Dim IngredFieldMarker As String * 1
  224.     Dim PrepFieldMarker As String * 1
  225.     Dim SpaceLoc As Integer
  226.  
  227.     Dim NumWords As Integer
  228.     Dim FieldMark As String * 1
  229.     ReDim FieldMarkType(3) As String * 1
  230.     Dim FMTIndex As Integer
  231.     Dim LPCount As Integer
  232.     Dim RPCount As Integer
  233.     
  234.     MakeMouseCursorHourglass
  235.     frmPleaseWait.Show
  236.     frmPleaseWait.lblPleaseWait.Refresh
  237.  
  238.     cmdSearch.Enabled = False
  239.     cmdClear.Enabled = False
  240.     cmdExit.Enabled = False
  241.     
  242.     'Initialize search field markers
  243.     IngredFieldMarker$ = Chr$(200)
  244.     PrepFieldMarker$ = Chr$(201)
  245.     FieldMark$ = Chr$(213)
  246.     FieldMarkType$(1) = Chr$(2)
  247.     FieldMarkType$(2) = Chr$(3)
  248.     FieldMarkType$(3) = Chr$(4)
  249.  
  250.     'Combine the input fields into one buffer
  251.     Title$ = Trim$(txtTitleWords.Text)
  252.     Ingred$ = Trim$(txtIngredients1.Text & " " & txtIngredients2.Text & " " & txtIngredients3.Text & " " & txtIngredients4.Text & " " & txtIngredients5.Text & " " & txtIngredients6.Text & " " & txtIngredients7.Text & " " & txtIngredients8.Text)
  253.     Prep$ = Trim$(txtPreparationWords.Text)
  254.     SearchBuffer$ = Title$ & IngredFieldMarker$ & " " & Ingred$ & PrepFieldMarker$ & " " & Prep$
  255.  
  256.     'Break that buffer into individual words, up to 100
  257.     For x = 1 To 100
  258.         SearchBuffer$ = Trim$(SearchBuffer$)
  259.         SpaceLoc = InStr(SearchBuffer$, " ")
  260.         If SpaceLoc = 0 Then
  261.             SearchWord$(x) = SearchBuffer$
  262.             Exit For
  263.         Else
  264.             SearchWord$(x) = Left$(SearchBuffer$, SpaceLoc - 1)
  265.             SearchBuffer$ = Mid$(SearchBuffer$, SpaceLoc + 1)
  266.         End If
  267.     Next x
  268.     NumWords = x
  269.  
  270.     'Now parse the search words and create the search string.
  271.     FMTIndex = 1
  272.     For x = 1 To NumWords
  273.         If SearchWord$(x) <> "" And SearchWord$(x) <> "!" Then
  274.             If SearchWord$(x) = IngredFieldMarker$ Then
  275.                 FMTIndex = 2
  276.             Else
  277.                 If SearchWord$(x) = PrepFieldMarker$ Then
  278.                     FMTIndex = 3
  279.                 Else
  280.                     If Left$(SearchWord$(x), 1) = "!" Then
  281.                         If Left$(SearchWord$(x), 2) = "!(" Then
  282.                             SearchExp = SearchExp & "! " & "( " & FieldMark & FieldMarkType(FMTIndex) & Mid$(SearchWord$(x), 3) & " "
  283.                         Else
  284.                             SearchExp = SearchExp & "! " & FieldMark & FieldMarkType(FMTIndex) & Mid$(SearchWord$(x), 2) & " "
  285.                         End If
  286.                     Else
  287.                         SearchExp = SearchExp & FieldMark & FieldMarkType(FMTIndex) & SearchWord$(x) & " "
  288.                     End If
  289.                     'Check Field Marks
  290.                     If Right$(Trim$(SearchExp), 1) = IngredFieldMarker$ Then
  291.                         FMTIndex = 2
  292.                         SearchExp = Left$(Trim$(SearchExp), Len(Trim$(SearchExp)) - 1) & " "
  293.                     End If
  294.                     If Right$(Trim$(SearchExp), 1) = PrepFieldMarker$ Then
  295.                         FMTIndex = 3
  296.                         SearchExp = Left$(Trim$(SearchExp), Len(Trim$(SearchExp)) - 1) & " "
  297.                     End If
  298.                     SearchExp = SearchExp & "& "
  299.                 End If
  300.             End If
  301.         End If
  302.     Next x
  303.     
  304.     'Set the searchexp to UPPERCASE, and verify parentheses
  305.     SearchExp$ = UCase$(Trim$(SearchExp$))
  306.     If Right$(SearchExp$, 1) = "&" Then SearchExp$ = Trim$(Left$(SearchExp$, Len(SearchExp$) - 1))
  307.     LPCount = 0
  308.     RPCount = 0
  309.     For x = 1 To Len(SearchExp$)
  310.         If Mid$(SearchExp$, x, 1) = "(" Then LPCount = LPCount + 1
  311.         If Mid$(SearchExp$, x, 1) = ")" Then RPCount = RPCount + 1
  312.     Next x
  313.  
  314.     If LPCount <> RPCount Then
  315.         x = 0
  316.         Do
  317.             x = x + 1
  318.             If x > Len(SearchExp$) Then Exit Do
  319.             If Mid$(SearchExp$, x, 1) = "(" Or Mid$(SearchExp$, x, 1) = ")" Then
  320.                 SearchExp$ = Left$(SearchExp$, x - 1) & Mid$(SearchExp$, x + 1)
  321.             End If
  322.         Loop
  323.         x = MsgBox("Your parentheses are not paired equally.  They have been removed.  " & Chr$(10) & "Do you still wish to search?", 49, "Unmatched Parentheses")
  324.         If x = 2 Then Exit Sub '1 = MB_OKCANCEL
  325.  
  326.     End If
  327.     
  328.     
  329.     If TRListID <> 0 Then
  330.         x = CloseTRList(TRListID)
  331.     End If
  332.     SearchExp$ = SearchExp$ & Chr$(0)
  333.     x = ExpressionSearch(SearchExp$)
  334.     'BLTId must be set to reflect the TRList that is open.
  335.     ' otherwise, it will be left at 1, and the chapter
  336.     ' headings will reflect 1,094,000 recipes!
  337.     BLTId = Popstack()
  338.     x = Pushstack(BLTId)
  339.     TRListID = OpenTRList()
  340.     x = LastResultTRCount(RecipesFound)
  341.     x = GetNextTRNumber(TRListID, TRNumber)
  342.     cmdSearch.Enabled = True
  343.     cmdClear.Enabled = True
  344.     cmdExit.Enabled = True
  345.     frmPleaseWait.Hide
  346.     MakeMouseCursorDefault
  347.  
  348.     If RecipesFound = 0 Then
  349.         MsgBox "No recipes match search."
  350.     Else
  351.         If RecipesFound > FirstRecordInBook(53) Then RecipesFound = FirstRecordInBook(53)
  352.         frmCookbook.lblTotalRecipes.Caption = Trim$(CStr(RecipesFound)) & " recipes found"
  353.         frmCookbook.lblRecipesInBook.Caption = ""
  354.     End If
  355.     
  356.     MakeMouseCursorHourglass
  357.     Hide
  358.     frmCookbook.Show
  359.     If RecipesFound > 0 Then GetBooks
  360.     MakeMouseCursorDefault
  361.  
  362. End Sub
  363.  
  364. Sub Form_Load ()
  365. ' centering the form
  366. Me.Left = (screen.Width - Me.Width) / 2
  367. Me.Top = Abs((screen.Height - Me.Height) / 2)
  368.     
  369.  
  370. End Sub
  371.  
  372. '--------------------------------------------------------------------------
  373. Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  374.     If UnloadMode = 0 Then Call cmdExit_Click
  375.  
  376. End Sub
  377.  
  378. '--------------------------------------------------------------------------
  379. Sub lblIngredientWords_Click ()
  380.     If txtIngredients1 = "" Then
  381.         txtIngredients1.SetFocus
  382.     Else
  383.         If txtIngredients2 = "" Then
  384.             txtIngredients2.SetFocus
  385.         Else
  386.             If txtIngredients3 = "" Then
  387.                 txtIngredients3.SetFocus
  388.             Else
  389.                 If txtIngredients4 = "" Then
  390.                     txtIngredients4.SetFocus
  391.                 Else
  392.                     If txtIngredients5 = "" Then
  393.                         txtIngredients5.SetFocus
  394.                     Else
  395.                         If txtIngredients6 = "" Then
  396.                             txtIngredients6.SetFocus
  397.                         Else
  398.                             If txtIngredients7 = "" Then
  399.                                 txtIngredients7.SetFocus
  400.                             Else
  401.                                 txtIngredients8.SetFocus
  402.                             End If
  403.                         End If
  404.                     End If
  405.                 End If
  406.             End If
  407.         End If
  408.     End If
  409. End Sub
  410.  
  411. '--------------------------------------------------------------------------
  412. Sub lblPreparationWords_Click ()
  413.     txtPreparationWords.SetFocus
  414. End Sub
  415.  
  416. '--------------------------------------------------------------------------
  417. Sub lblTitleWords_Click ()
  418.     txtTitleWords.SetFocus
  419. End Sub
  420.  
  421. '--------------------------------------------------------------------------
  422. Sub txtIngredients1_KeyPress (KeyAscii As Integer)
  423.     If KeyAscii = 13 Then
  424.         txtPreparationWords.SetFocus
  425.         KeyAscii = 0
  426.     End If
  427. End Sub
  428.  
  429. '--------------------------------------------------------------------------
  430. Sub txtIngredients2_KeyPress (KeyAscii As Integer)
  431.     If KeyAscii = 13 Then
  432.         txtPreparationWords.SetFocus
  433.         KeyAscii = 0
  434.     End If
  435.  
  436. End Sub
  437.  
  438. '--------------------------------------------------------------------------
  439. Sub txtIngredients3_KeyPress (KeyAscii As Integer)
  440.     If KeyAscii = 13 Then
  441.         txtPreparationWords.SetFocus
  442.         KeyAscii = 0
  443.     End If
  444.  
  445. End Sub
  446.  
  447. '--------------------------------------------------------------------------
  448. Sub txtIngredients4_KeyPress (KeyAscii As Integer)
  449.     If KeyAscii = 13 Then
  450.         txtPreparationWords.SetFocus
  451.         KeyAscii = 0
  452.     End If
  453.  
  454. End Sub
  455.  
  456. '--------------------------------------------------------------------------
  457. Sub txtIngredients5_KeyPress (KeyAscii As Integer)
  458.     If KeyAscii = 13 Then
  459.         txtPreparationWords.SetFocus
  460.         KeyAscii = 0
  461.     End If
  462.  
  463. End Sub
  464.  
  465. '--------------------------------------------------------------------------
  466. Sub txtIngredients6_KeyPress (KeyAscii As Integer)
  467.     If KeyAscii = 13 Then
  468.         txtPreparationWords.SetFocus
  469.         KeyAscii = 0
  470.     End If
  471.  
  472. End Sub
  473.  
  474. '--------------------------------------------------------------------------
  475. Sub txtIngredients7_KeyPress (KeyAscii As Integer)
  476.     If KeyAscii = 13 Then
  477.         txtPreparationWords.SetFocus
  478.         KeyAscii = 0
  479.     End If
  480.  
  481. End Sub
  482.  
  483. '--------------------------------------------------------------------------
  484. Sub txtIngredients8_KeyPress (KeyAscii As Integer)
  485.     If KeyAscii = 13 Then
  486.         txtPreparationWords.SetFocus
  487.         KeyAscii = 0
  488.     End If
  489.  
  490. End Sub
  491.  
  492. '--------------------------------------------------------------------------
  493. Sub txtPreparationWords_KeyPress (KeyAscii As Integer)
  494.     
  495.     If KeyAscii = 13 Then
  496.         cmdSearch.SetFocus
  497.         KeyAscii = 0
  498.     End If
  499.  
  500.  
  501. End Sub
  502.  
  503. '--------------------------------------------------------------------------
  504. Sub txtTitleWords_KeyPress (KeyAscii As Integer)
  505.     
  506.     If KeyAscii = 13 Then
  507.         txtIngredients1.SetFocus
  508.         KeyAscii = 0
  509.     End If
  510.  
  511. End Sub
  512.  
  513.